home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATHLIB / TRIGSTUF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-21  |  6KB  |  309 lines
  1. {$N+}
  2. UNIT TrigStuff;
  3.  
  4. INTERFACE
  5.  
  6. CONST   maxfloatray = 6551;                             { needed for POLY }
  7. TYPE    floatray = ARRAY[0..maxfloatray] OF DOUBLE;     { needed for POLY }
  8.  
  9. FUNCTION TAN(x: DOUBLE):DOUBLE;
  10. { returns the tangent of x }
  11.  
  12. PROCEDURE SINCOS(x:DOUBLE; VAR y,z:DOUBLE);
  13. { returns y = SIN(x) and z = COS(x) }
  14.  
  15. FUNCTION ArcTangent(x,y: DOUBLE):DOUBLE;
  16. { returns arctan(y/x) in radians between zero and 2 pi }
  17.  
  18. FUNCTION ArcCOS(x: DOUBLE):DOUBLE;
  19. { returns the inverse cosine of x }
  20.  
  21. FUNCTION ArcSIN(x: DOUBLE):DOUBLE;
  22. { returns the inverse sine of x }
  23.  
  24. FUNCTION Expo(x,y: DOUBLE):DOUBLE;
  25. { exponentiation: x^y }
  26.  
  27. FUNCTION Two2TheX(x:DOUBLE):DOUBLE;
  28. { exponentiation: 2^x }
  29.  
  30. FUNCTION Ten2TheX(x:DOUBLE):DOUBLE;
  31. { exponentiation: 10^x }
  32.  
  33. FUNCTION LOG(x: DOUBLE):DOUBLE;
  34. { returns the logarithm to base 10 of x }
  35.  
  36. FUNCTION CEIL(x:DOUBLE):DOUBLE;
  37. { returns smallest integer larger than x }
  38.  
  39. FUNCTION FLOOR(x:DOUBLE):DOUBLE;
  40. { returns largest integer smaller than x }
  41.  
  42. FUNCTION FMOD(x,y:DOUBLE):DOUBLE;
  43. { returns f such that x := a*y + f where a = integer & f in [0,y) }
  44.  
  45. FUNCTION FREXP(x:DOUBLE; VAR n:INTEGER):DOUBLE;
  46. { returns m for which x = m*2^n with m in [0.5,1) }
  47.  
  48. FUNCTION HYPOT(x,y:DOUBLE):DOUBLE;
  49. { returns hypotenuse = SQRT(SQR(x)=SQR(y)) }
  50.  
  51. FUNCTION LDEXP(x:DOUBLE; i:INTEGER):DOUBLE;
  52. { returns x*2^i }
  53.  
  54. FUNCTION MODF(x:DOUBLE; VAR i:DOUBLE):DOUBLE;
  55. { returns fractional part of x; gives integer part of x in i }
  56.  
  57. FUNCTION POLY(x:DOUBLE; n:INTEGER; VAR degree):DOUBLE;
  58. { returns y = c0 + c1*x + c2*x^2 + ... + cn*x^n; n = polynomial order }
  59.  
  60. FUNCTION SINH(x:DOUBLE):DOUBLE;
  61. { returns hyperbolic sine }
  62.  
  63. FUNCTION COSH(x:DOUBLE):DOUBLE;
  64. { returns hyperbolic cosine }
  65.  
  66. FUNCTION TANH(x:DOUBLE):DOUBLE;
  67. { returns hyperbolic tangent }
  68.  
  69. FUNCTION ASINH(x:DOUBLE):DOUBLE;
  70. { returns inverse hyperbolic sine }
  71.  
  72. FUNCTION ACOSH(x:DOUBLE):DOUBLE;
  73. { returns inverse hyperbolic cosine }
  74.  
  75. FUNCTION ATANH(x:DOUBLE):DOUBLE;
  76. { returns inverse hyperbolic tangent }
  77.  
  78. IMPLEMENTATION
  79.  
  80.  
  81.   FUNCTION TAN(x:DOUBLE):DOUBLE;
  82.   CONST   piM2 = 6.283185308;
  83.  
  84.   VAR     cosx: DOUBLE;
  85.   
  86.     BEGIN
  87.       TAN := SIN(x) / COS(x);
  88.     END {TAN};
  89.  
  90.   
  91.   PROCEDURE SINCOS(x:DOUBLE; VAR y,z:DOUBLE);
  92.   
  93.     BEGIN
  94.       y := SIN(x);
  95.       z := COS(x);
  96.     END {SINCOS};
  97.       
  98.  
  99.   FUNCTION ArcTangent;
  100.   VAR  a: DOUBLE;
  101.   
  102.     BEGIN
  103.       IF x <> 0 THEN
  104.         BEGIN
  105.           a := ARCTAN(ABS(y/x));
  106.           IF x > 0 THEN
  107.             IF y >= 0 THEN ArcTangent := a       { first quadrant }
  108.             ELSE           ArcTangent := 2*pi-a  { fourth quadrant }
  109.           ELSE { x < 0 }
  110.             IF y >= 0 THEN ArcTangent := pi - a  { second quadrant }
  111.             ELSE           ArcTangent := pi + a  { third quadrant }
  112.         END
  113.       ELSE { x = 0 }
  114.         IF y = 0 THEN ArcTangent := 0.0
  115.         ELSE
  116.           IF y > 0  THEN ArcTangent := pi/2
  117.           ELSE           ArcTangent := 3*pi/2;
  118.     END {ArcTangent};
  119.       
  120.   
  121.   FUNCTION ArcCOS;
  122.   VAR   result: DOUBLE;
  123.  
  124.   BEGIN
  125.     IF x = 0 THEN
  126.       result := pi/2
  127.     ELSE
  128.       IF x = 1 THEN
  129.         result := 0
  130.       ELSE
  131.         IF x = -1 THEN
  132.           result := pi
  133.         ELSE
  134.           result := ArcTangent(x/SQRT(1 - SQR(x)),1);
  135.     ArcCOS := result;
  136.   END {ArcCOS};
  137.  
  138.  
  139.    
  140.  FUNCTION ArcSIN;
  141.  
  142.    BEGIN
  143.      IF x = 0 THEN
  144.        ArcSIN := 0
  145.      ELSE
  146.        IF x = 1 THEN
  147.          ArcSIN := pi/2
  148.        ELSE
  149.          IF x = -1 THEN
  150.            ArcSIN := - pi/2
  151.          ELSE
  152.            ArcSIN := ARCTAN(x/SQRT(1-SQR(x)));
  153.    END {ArcSIN};
  154.    
  155.  
  156.  FUNCTION Expo;
  157.  
  158.    BEGIN
  159.      IF x > 0 THEN
  160.        Expo := EXP(y*LN(x))
  161.      ELSE
  162.        Expo := 0;
  163.    END {Expo};
  164.    
  165.  
  166.   FUNCTION Two2TheX(x:DOUBLE):DOUBLE;
  167.     
  168.     BEGIN
  169.       Two2TheX := Expo(2,x);
  170.     END {Two2TheX};
  171.   
  172.   
  173.   FUNCTION Ten2TheX(x:DOUBLE):DOUBLE;
  174.     
  175.     BEGIN
  176.       Ten2TheX := Expo(10,x);
  177.     END {Ten2TheX};
  178.  
  179.   
  180.  FUNCTION LOG;
  181.  CONST LN10 = 2.302585093;
  182.  
  183.    BEGIN
  184.      LOG := LN(x) / LN10
  185.    END {LOG};
  186.    
  187.    
  188.   FUNCTION CEIL(x:DOUBLE):DOUBLE;
  189.  
  190.     BEGIN
  191.       IF x > 0 THEN CEIL := TRUNC(x) + 1 ELSE CEIL := TRUNC(x);
  192.     END {CEIL};
  193.  
  194.   
  195.   FUNCTION FLOOR(x:DOUBLE):DOUBLE;
  196.   VAR  y: DOUBLE;
  197.  
  198.     BEGIN
  199.       IF x >= 0 THEN FLOOR := TRUNC(x) ELSE BEGIN
  200.         y := ROUND(x);
  201.         IF ROUND(x) > x THEN FLOOR := y - 1 ELSE FLOOR := y;
  202.       END {FLOOR};
  203.     END;
  204.  
  205.  
  206.   FUNCTION FMOD(x,y:DOUBLE):DOUBLE;
  207.   VAR  a,f: DOUBLE;
  208.  
  209.     BEGIN
  210.       a := TRUNC(x/y);
  211.       f := x - a*y;
  212.       FMOD := f;
  213.     END {FMOD};
  214.  
  215.  
  216.   FUNCTION FREXP(x:DOUBLE; VAR n:INTEGER):DOUBLE;
  217.   CONST   ln2 = 0.6931471805599453094172;{ natural logarithm of 2  }
  218.   VAR     m: DOUBLE;
  219.  
  220.    BEGIN
  221.      { n is ROUND TO +INF(ln(x)/ln2) }
  222.      IF x <> 0 THEN BEGIN
  223.        n := TRUNC(ln(ABS(x))/ln2);
  224.        IF ABS(x) >= 1 THEN INC(n);
  225.        m := EXP(ln(ABS(x))-n*ln2);
  226.        IF x < 0 THEN m := -m;
  227.      END ELSE BEGIN
  228.        m := 0; n := 0;
  229.      END;
  230.      FREXP := m;
  231.    END {FREXP};
  232.  
  233.  
  234.   FUNCTION HYPOT(x,y:DOUBLE):DOUBLE;
  235.  
  236.    BEGIN
  237.      HYPOT := SQRT(SQR(x) + SQR(y));
  238.    END {HYPOT};
  239.   
  240.  
  241.   FUNCTION LDEXP(x:DOUBLE; i:INTEGER):DOUBLE;
  242.   
  243.     BEGIN
  244.       LDEXP := x*EXP(i*LN(2));
  245.     END {LDEXP};
  246.   
  247.  
  248.   FUNCTION MODF(x:DOUBLE; VAR i:DOUBLE):DOUBLE;
  249.  
  250.     BEGIN
  251.       i := TRUNC(x);
  252.       MODF := x - i;
  253.     END {MODF};
  254.  
  255.  
  256.   FUNCTION POLY(x:DOUBLE; n:INTEGER; VAR degree):DOUBLE;
  257.   VAR  i:INTEGER;
  258.        y: DOUBLE;
  259.  
  260.     BEGIN
  261.       y := 0;
  262.       FOR i := n DOWNTO 0 DO  y := y*x + floatray(degree)[i];
  263.       POLY := y;
  264.     END {POLY};
  265.  
  266.  
  267.   FUNCTION SINH(x:DOUBLE):DOUBLE;
  268.   VAR temp: DOUBLE;
  269.  
  270.     BEGIN
  271.       temp := EXP(x);
  272.       SINH := 0.5*(temp-1/temp);
  273.     END {SINH};
  274.  
  275.   FUNCTION COSH(x:DOUBLE):DOUBLE;
  276.   VAR temp: DOUBLE;
  277.  
  278.     BEGIN
  279.       temp := EXP(x);
  280.       COSH := 0.5*(temp+1/temp);
  281.     END {COSH};
  282.  
  283.   FUNCTION TANH(x:DOUBLE):DOUBLE;
  284.   VAR temp: DOUBLE;
  285.  
  286.     BEGIN
  287.       temp := EXP(2*x);
  288.       TANH := (temp-1)/(temp+1);
  289.     END {TANH};
  290.  
  291.   FUNCTION ASINH(x:DOUBLE):DOUBLE;
  292.  
  293.     BEGIN
  294.       ASINH := LN(x + SQRT(SQR(x)+1));
  295.     END {ASINH};
  296.  
  297.   FUNCTION ACOSH(x:DOUBLE):DOUBLE;
  298.  
  299.     BEGIN
  300.       ACOSH := LN(x + SQRT(SQR(x)-1));
  301.     END {ACOSH};
  302.  
  303.   FUNCTION ATANH(x:DOUBLE):DOUBLE;
  304.  
  305.     BEGIN
  306.       ATANH := 0.5 * LN((1+x)/(1-x));
  307.     END {ATANH};
  308.  
  309. END.